

'--------------------------------------------------
' Hands-On 23-1
' No code in this Hands-On.
' Please follow the instructions in the book.
'--------------------------------------------------


'--------------------------------------------------
' Hands-On 23-2
'--------------------------------------------------

Option Explicit

' Global variables
Dim flag As Boolean          ' Boolean variable to indicate whether
                             ' to delete a drill-down worksheet
Dim strPivSheet As String    ' String to hold the name of the sheet
                             ' containing the PivotTable
Dim strDrillSheet As String  ' String to hold the name of the drill-down
                             ' sheet
Dim strPivSource As String   ' String to hold the name of the worksheet
                             ' with the PivotTable source data

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If strPivSheet = "" Then Exit Sub
    If Sh.Name <> strPivSheet Then
      If InStr(1, strPivSource, Sh.Name) = 0 Then
        If MsgBox("Do you want to Delete " & Sh.Name & _
            " from the workbook" & vbCrLf _
            & "upon returning to PivotTable report?", _
             vbYesNo + vbQuestion, _
             "Sheet: Delete or Keep") = vbYes Then
              flag = True
              strDrillSheet = Sh.Name
        Else
          flag = False
          Exit Sub
       End If
     End If
    End If
    If ActiveSheet.Name = strPivSheet And flag = True Then
        Application.DisplayAlerts = False
        Worksheets(strDrillSheet).Delete
        Application.DisplayAlerts = True
        flag = False
    End If
End Sub


Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
                ByVal Target As Range, Cancel As Boolean)
    With ActiveSheet
        If .PivotTables.Count > 0 Then
            strPivSource = ActiveSheet.PivotTables(1).SourceData
            If ActiveCell.PivotField.Name <> "" And IsEmpty(Target) Then
                MsgBox "There is no data in the selected cell " & _
                  "- cannot drill down."
                Cancel = True
                Exit Sub
            End If
            strPivSheet = ActiveSheet.Name
        End If
    End With
End Sub


'--------------------------------------------------
' Hands-On 23-3
'--------------------------------------------------

Sub CreateNewPivot()
    Dim wksData As Worksheet
    Dim rngData As Range
    Dim wksDest As Worksheet
    Dim pvtTable As PivotTable

    ' Set up object variables
    Set wksData = ThisWorkbook.Worksheets("Source Data")
    Set rngData = wksData.UsedRange
    Set wksDest = ThisWorkbook.Worksheets("Sheet2")

    ' Create a skeleton of a PivotTable

    Set pvtTable = wksData.PivotTableWizard(SourceType:=xlDatabase, _
       SourceData:=rngData, TableDestination:=wksDest.Range("B5"))

    ' Close the PivotTable Field List that appears automatically
    ActiveWorkbook.ShowPivotTableFieldList = False

    ' Add fields to the PivotTable
    With pvtTable
       .PivotFields("Vendor").Orientation = xlRowField
       .PivotFields("Equipment Type").Orientation = xlRowField
       .PivotFields("Warranty Type").Orientation = xlColumnField
       With .PivotFields("Total Units")
            .Orientation = xlDataField
            .Function = xlSum
       End With
       .PivotFields("Equipment Id").Orientation = xlPageField
    End With

    ' Autofit columns so all headings are visible
    wksDest.UsedRange.Columns.AutoFit
End Sub


'--------------------------------------------------
' Hands-On 23-4
'--------------------------------------------------

Sub PivotTable_External1()
    Dim strConn As String
    Dim strQuery_1 As String
    Dim strQuery_2 As String
    Dim myArray As Variant
    Dim destRange As Range
    Dim strPivot As String

    strConn = "Driver={Microsoft Access Driver (*.mdb)};" & _
          "DBQ=" & "C:\Ex07_ByExample\" & _
          "Northwind.mdb;"

    strQuery_1 = "SELECT Customers.CustomerID, Customers.CompanyName," & _
          "Orders.OrderDate, Products.ProductName, Sum([Order " & _
          "Details].[UnitPrice]*[QUantity]*(1-[Discount])) AS Total " & _
          "FROM Products INNER JOIN ((Customers INNER JOIN Orders " & _
          "ON Customers.CustomerID = "

    strQuery_2 = "Orders.CustomerID) INNER JOIN [Order Details] " & _
          "ON Orders.OrderID = [Order Details].OrderID) ON " & _
          "Products.ProductID = [Order Details].ProductID " & _
          "GROUP BY Customers.CustomerID, Customers.CompanyName, " & _
          "Orders.OrderDate, Products.ProductName;"

    myArray = Array(strConn, strQuery_1, strQuery_2)
    Worksheets.Add

    Set destRange = ActiveSheet.Range("B5")
    strPivot = "PivotFromAccess"

    ActiveSheet.PivotTableWizard _
         SourceType:=xlExternal, _
         SourceData:=myArray, _
         TableDestination:=destRange, _
         TableName:=strPivot, _
         SaveData:=False, _
         BackgroundQuery:=False

       ' Close the PivotTable Field List that appears automatically
        ActiveWorkbook.ShowPivotTableFieldList = False

        ' Add fields to the PivotTable
        With ActiveSheet.PivotTables(strPivot)
           .PivotFields("ProductName").Orientation = xlRowField
           .PivotFields("CompanyName").Orientation = xlRowField
           With .PivotFields("Total")
                .Orientation = xlDataField
                .Function = xlSum
                .NumberFormat = "$#,##0.00"
           End With
           .PivotFields("CustomerID").Orientation = xlPageField
           .PivotFields("OrderDate").Orientation = xlPageField
        End With

        ' Autofit columns so all headings are visible
        ActiveSheet.UsedRange.Columns.AutoFit
End Sub


'--------------------------------------------------
' Hands-On 23-5
'--------------------------------------------------

Sub Pivot_External2()
    Dim objPivotCache As PivotCache
    Dim conn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim dbPath As String
    Dim strSQL As String
    
    dbPath = "C:\Ex07_HandsOn\Northwind 2007.accdb"
                  
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & dbPath & _
            "; Persist Security Info=False;"
  
    strSQL = "SELECT Products.[Product Name], " & _
             "Orders.[Order Date], " & _
             "Sum([Unit Price]*[Quantity]) AS Amount " & _
             "FROM Orders INNER JOIN (Products INNER JOIN " & _
             "[Order Details] ON Products.ID = " & _
             "[Order Details].[Product ID]) ON " & _
             "Orders.[Order ID] = [Order Details].[Order ID] " & _
             "GROUP BY Products.[Product Name], " & _
             "Orders.[Order Date], Products.[Product Name]" & _
             "ORDER BY Sum([Unit Price]*[Quantity]) DESC , " & _
             "Products.[Product Name];"
 
    Set rst = conn.Execute(strSQL)
       
    ' Create a PivotTable cache and report
    Set objPivotCache = ActiveWorkbook.PivotCaches.Add( _
        SourceType:=xlExternal)
    Set objPivotCache.Recordset = rst

    Worksheets.Add
    With objPivotCache
        .CreatePivotTable TableDestination:=Range("B6"), _
            TableName:="Invoices"
    End With

    ' Add fields to the PivotTable
    With ActiveSheet.PivotTables("Invoices")
        .SmallGrid = False
        With .PivotFields("Product Name")
            .Orientation = xlRowField
            .Position = 1
        End With
        With .PivotFields("Order Date")
            .Orientation = xlRowField
            .Position = 2
            .Name = "Date"
        End With
        With .PivotFields("Amount")
            .Orientation = xlDataField
            .Position = 1
            .NumberFormat = "$#,##0.00"
        End With
    End With

    ' Autofit columns so all headings are visible
    ActiveSheet.UsedRange.Columns.AutoFit

    ' Clean up
    Set cmd = Nothing
    Set rst = Nothing

    ' Obtain information about PivotCache
    With ActiveSheet.PivotTables("Invoices").PivotCache
        Debug.Print "Information about the PivotCache"
        Debug.Print "Number of Records: " & .RecordCount
        Debug.Print "Data was last refreshed on: " & .RefreshDate
        Debug.Print "Data was last refreshed by: " & .RefreshName
        Debug.Print "Memory used by PivotCache: " & .MemoryUsed & _
            " (bytes)"
    End With
End Sub


'--------------------------------------------------
' Hands-On 23-6
'--------------------------------------------------

Sub FormatPivotTable()
    Dim pvtTable As PivotTable
    Dim strPiv As String

    If ActiveSheet.PivotTables.Count > 0 Then
        strPiv = ActiveSheet.PivotTables(1).Name
        Set pvtTable = ActiveSheet.PivotTables(strPiv)
    Else
        Exit Sub
    End If

    With pvtTable
        .PivotFields("OrderDate").Orientation = xlRows
        .PivotFields("CompanyName").Orientation = xlHidden

        ' use this statement to group OrderDate by year
        .PivotFields("OrderDate").DataRange.Cells(1).Group _
            Start:=True, End:=True, _
            periods:=Array(False, False, False, False, False, False, _
            True)

        ' use this statement to group OrderDate both by quarter and year
        ' .PivotFields("OrderDate").DataRange.Cells(1).Group _
            Start:=True, End:=True, _
            periods:=Array(False, False, False, False, False, True, True)

        .PivotFields("OrderDate").Orientation = xlColumns
        .TableRange1.AutoFormat Format:=xlRangeAutoFormatColor2
        .PivotFields("ProductName").DataRange.Select

        ' sort the Product Name field in descending order based on the
        ' Sum of Total
        .PivotFields("ProductName").AutoSort xlDescending, "Sum of Total"
        Selection.IndentLevel = 2
        With Selection.Font
            .Name = "Times New Roman"
            .FontStyle = "Bold"
            .Size = 10
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
End Sub


Sub Hide1996Data()
    Dim myPivot As PivotTable
    Dim myItem As PivotItem
    Dim strFieldLabel As String
    
    strFieldLabel = "1996"

    Set myPivot = ActiveSheet.PivotTables(1)
    For Each myItem In myPivot.PivotFields("OrderDate").PivotItems
        If myItem.Name <> strFieldLabel Then
            myItem.Visible = True
        Else
            myItem.Visible = False
        End If
    Next
End Sub


'--------------------------------------------------
' Hands-On 23-7
'--------------------------------------------------

Sub PivotWithCalcFields()
    ActiveWorkbook.PivotCaches.Add( _
        SourceType:=xlDatabase, _
        SourceData:="Sheet1!R1C1:R4C4").CreatePivotTable _
        TableDestination:="'[Practice_Excel23b.xlsm]Sheet1'!R4C7", _
        TableName:="Piv1", _
        DefaultVersion:=xlPivotTableVersion10

    With ActiveSheet.PivotTables("Piv1").PivotFields("Product")
        .Orientation = xlRowField
        .Position = 1
    End With

    ActiveSheet.PivotTables("Piv1").AddDataField _
        ActiveSheet.PivotTables("Piv1").PivotFields("2001"), _
        "Sum of 2001", xlSum
    ActiveSheet.PivotTables("Piv1").AddDataField _
        ActiveSheet.PivotTables("Piv1").PivotFields("2000"), _
        "Sum of 2000", xlSum
    ActiveSheet.PivotTables("Piv1").AddDataField _
        ActiveSheet.PivotTables("Piv1").PivotFields("1999"), _
        "Sum of 1999", xlSum
    ActiveSheet.PivotTables("Piv1").CalculatedFields.Add _
        "Change: 2001/2000", "='2001' -'2000'", True
    ActiveSheet.PivotTables("Piv1").CalculatedFields.Add _
        "Change: 2000/1999", "='2000' -'1999'", True
    ActiveSheet.PivotTables("Piv1"). _
        PivotFields("Change: 2001/2000"). _
        Orientation = xlDataField
    ActiveSheet.PivotTables("Piv1"). _
        PivotFields("Change: 2000/1999"). _
        Orientation = xlDataField
    ActiveSheet.PivotTables("Piv1"). _
        PivotFields("Data").Orientation = xlColumnField

End Sub


'--------------------------------------------------
' Hands-On 23-8
'--------------------------------------------------

Sub PivotWithCalcItems()
    Dim strConn As String
    Dim strSQL As String
    Dim myArray As Variant
    Dim destRng As Range
    Dim strPivot As String

    strConn = "Driver={Microsoft Access Driver (*.mdb)};" & _
              "DBQ=" & "C:\Ex07_ByExample\" & _
              "Northwind.mdb;"

    strSQL = "SELECT Invoices.Customers.CompanyName, " & _
              "Invoices.Country, Invoices.Salesperson, " & _
              "Invoices.ProductName, Invoices.ExtendedPrice " & _
              "FROM Invoices ORDER BY Invoices.Country"

    myArray = Array(strConn, strSQL)
    Worksheets.Add

    Set destRng = ActiveSheet.Range("B5")
    strPivot = "PivotTable1"

    ActiveSheet.PivotTableWizard _
        SourceType:=xlExternal, _
        SourceData:=myArray, _
        TableDestination:=destRng, _
        TableName:=strPivot, _
        SaveData:=False, _
        BackgroundQuery:=False

    With ActiveSheet.PivotTables(strPivot).PivotFields("CompanyName")
        .Orientation = xlPageField
        .Position = 1
    End With

    With ActiveSheet.PivotTables(strPivot).PivotFields("Country")
        .Orientation = xlRowField
        .Position = 1
    End With

    ActiveSheet.PivotTables(strPivot).AddDataField _
        ActiveSheet.PivotTables(strPivot).PivotFields("ExtendedPrice"), _
        "Sum of ExtendedPrice", xlSum

    With ActiveSheet.PivotTables(strPivot).PivotFields("Salesperson")
        .Orientation = xlRowField
        .Position = 1
    End With

    With ActiveSheet.PivotTables(strPivot).PivotFields("Salesperson")
        .Orientation = xlPageField
        .Position = 1
    End With

    With ActiveSheet.PivotTables(strPivot).PivotFields("Salesperson")
        .Orientation = xlColumnField
        .Position = 1
    End With

    ActiveSheet.PivotTables(strPivot).PivotFields("Country"). _
        CalculatedItems.Add "North America", "=USA+Canada", True
    ActiveSheet.PivotTables(strPivot).PivotFields("Country"). _
        CalculatedItems.Add "South America", _
        "=Argentina+Brazil+Venezuela ", True
    ActiveSheet.PivotTables(strPivot).PivotFields("Country"). _
        CalculatedItems("North America").StandardFormula = _
        "=USA+Canada+Mexico"
    ActiveSheet.PivotTables(strPivot).PivotFields("Country"). _
        CalculatedItems.Add "Europe", _
        "=Austria+Belgium+Denmark+Finland+" & _
        "France+Germany+Ireland+Italy+Norway+Poland+" & _
        "Portugal+Spain+Sweden+Switzerland+UK", True


    ActiveSheet.PivotTables(strPivot).PivotFields("Salesperson"). _
        CalculatedItems.Add "Male", _
        "=Michael Suyama+Andrew Fuller+Robert King+" & _
        "Steven Buchanan", True
        
    ActiveSheet.PivotTables(strPivot).PivotFields("Salesperson"). _
        CalculatedItems.Add "Female", _
        "=Anne Dodsworth+Laura Callahan+Janet Leverling+" & _
        "Margaret Peacock+Nancy Davolio", True
        
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Salesperson")
        .PivotItems("Andrew Fuller").Visible = False
        .PivotItems("Anne Dodsworth").Visible = False
        .PivotItems("Janet Leverling").Visible = False
        .PivotItems("Laura Callahan").Visible = False
        .PivotItems("Margaret Peacock").Visible = False
        .PivotItems("Michael Suyama").Visible = False
        .PivotItems("Nancy Davolio").Visible = False
        .PivotItems("Robert King").Visible = False
        .PivotItems("Steven Buchanan").Visible = False
    End With
    
    With ActiveSheet.PivotTables(strPivot).PivotFields("Country")
        .PivotItems("Argentina").Visible = False
        .PivotItems("Austria").Visible = False
        .PivotItems("Belgium").Visible = False
        .PivotItems("Brazil").Visible = False
        .PivotItems("Canada").Visible = False
        .PivotItems("Denmark").Visible = False
        .PivotItems("Finland").Visible = False
        .PivotItems("France").Visible = False
        .PivotItems("Germany").Visible = False
        .PivotItems("Ireland").Visible = False
        .PivotItems("Italy").Visible = False
        .PivotItems("Mexico").Visible = False
        .PivotItems("Norway").Visible = False
        .PivotItems("Poland").Visible = False
        .PivotItems("Portugal").Visible = False
        .PivotItems("Spain").Visible = False
        .PivotItems("Sweden").Visible = False
        .PivotItems("Switzerland").Visible = False
        .PivotItems("UK").Visible = False
        .PivotItems("USA").Visible = False
        .PivotItems("Venezuela").Visible = False
    End With

    ActiveSheet.PivotTables(strPivot).PivotFields("Country").Caption = _
        "Continent"

    With ActiveSheet.PivotTables(strPivot). _
       PivotFields("Sum of ExtendedPrice").NumberFormat = "$#,##0.00"
    End With

    With ActiveSheet.PivotTables(strPivot).PivotFields("ProductName")
        .Orientation = xlRowField
        .Position = 2
    End With

    ActiveSheet.PivotTables(strPivot). _
      PivotFields("ProductName").Orientation = xlHidden
End Sub


Sub ListCalcFieldsItems()
    Dim pivTable As PivotTable
    Dim fld As PivotField   ' field enumerator
    Dim itm As PivotItem    ' item enumerator
    Dim r As Integer        ' row number

    Set pivTable = Worksheets(1).PivotTables(1)

    On Error Resume Next

    ' print to the Immediate window the names of fields
    ' and calculated items
    For Each fld In pivTable.PivotFields
        If fld.IsCalculated Then
           Debug.Print fld.Name & ":" & _
                    fld.Name & vbTab & "-->Calculated field"
        Else
            Debug.Print fld.Name
        End If
        For Each itm In pivTable. _
            PivotFields(fld.Name).CalculatedItems
                Debug.Print fld.Name & ":" & _
                    itm.Name & vbTab & "-->Calculated item"
                ' enter information about Calculated items
                ' in a worksheet
                r = r + 1
                With Worksheets("Sheet2")
                    .Cells(r, 1).Value = itm.Name
                    .Cells(r, 2).Value = Chr(39) & itm.Formula
                End With
        Next
    Next
End Sub


'--------------------------------------------------
' Hands-On 23-9
'--------------------------------------------------

Sub GeneratePivotReport()
    Dim strConn As String
    Dim strSQL As String
    Dim myArray As Variant
    Dim destRng As Range
    Dim strPivot As String

    strConn = "Driver={Microsoft Access Driver (*.mdb)};" & _
              "DBQ=" & "C:\Ex07_ByExample\Northwind.mdb;"

    strSQL = "SELECT Invoices.Customers.CompanyName, " & _
              "Invoices.Country, Invoices.Salesperson, " & _
              "Invoices.ProductName, Invoices.ExtendedPrice " & _
              "FROM Invoices ORDER BY Invoices.Country"

    myArray = Array(strConn, strSQL)
    Worksheets.Add

    Set destRng = ActiveSheet.Range("B5")
    strPivot = "PivotTable1"

    ActiveSheet.PivotTableWizard _
            SourceType:=xlExternal, _
            SourceData:=myArray, _
            TableDestination:=destRng, _
            TableName:=strPivot, _
            SaveData:=False, _
            BackgroundQuery:=False

    With ActiveSheet.PivotTables(strPivot).PivotFields("ProductName")
        .Orientation = xlPageField
        .Position = 1
    End With


    With ActiveSheet.PivotTables(strPivot).PivotFields("Country")
        .Orientation = xlRowField
        .Position = 1
    End With

    With ActiveSheet.PivotTables(strPivot).PivotFields("Salesperson")
        .Orientation = xlColumnField
        .Position = 1
    End With

    ActiveSheet.PivotTables(strPivot).AddDataField _
        ActiveSheet.PivotTables(strPivot).PivotFields("ExtendedPrice"), _
        "Sum of ExtendedPrice", xlSum

    With ActiveSheet.PivotTables(strPivot). _
       PivotFields("Sum of ExtendedPrice").NumberFormat = "$#,##0.00"
    End With
End Sub


Sub CreatePivotChart()
    Dim shp As Shape
    Dim rngSource As Range
    Dim pvtTable As PivotTable
    Dim r As Integer

    Set pvtTable = Worksheets("Sheet4").PivotTables(1)

    ' set the current page for the PivotTable report to the
    ' page named "Tofu"
    pvtTable.PivotFields("ProductName").CurrentPage = "Tofu"
    
    Set rngSource = pvtTable.TableRange2
    Set shp = ActiveSheet.Shapes.AddChart
       
    shp.Chart.SetSourceData Source:=rngSource
    shp.Chart.SetElement (msoElementChartTitleAboveChart)
    shp.Chart.ChartTitle.Caption = _
       pvtTable.PivotFields("ProductName").CurrentPage
           
    r = ActiveSheet.UsedRange.Rows.Count + 3
           
    With Range("B" & r & ":E" & r + 15)
        shp.Width = .Width
        shp.Height = .Height
        shp.Left = .Left
        shp.Top = .Top
    End With
End Sub


Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim strPivotPage As String
    Dim r As Integer
      
    strPivotPage = Target.PivotFields("ProductName").CurrentPage.Value
        
    If ActiveSheet.ChartObjects.Count > 0 Then
        ActiveSheet.ChartObjects(1).Activate
        ActiveChart.ChartTitle.Text = strPivotPage
                      
        r = ActiveSheet.UsedRange.Rows.Count + 3
    
        With Range("B" & r)
            ActiveSheet.ChartObjects(1).Top = .Top
        End With
    End If
End Sub


